home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / CMPLTPAS / VECTORS.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-01  |  11KB  |  337 lines
  1. {--------------------------------------------------------------}
  2. {                           VECTORS                            }
  3. {                                                              }
  4. {                   Interrupt vector utility                   }
  5. {                                                              }
  6. {                             by Jeff Duntemann                }
  7. {                             Turbo Pascal V5.0                }
  8. {                             Last update 7/1/88               }
  9. {                                                              }
  10. { This program allows you to inspect and change 8086 interrupt }
  11. { vectors, and look at the first 256 bytes pointed to by any   }
  12. { vector.  This allows the spotting of interrupt service       }
  13. { routine "signatures" (typically the vendor's copyright       }
  14. { notice) and also indicates when a vector points to an IRET.  }
  15. {                                                              }
  16. {      From: COMPLETE TURBO PASCAL 5.0   by Jeff Duntemann     }
  17. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  18. {--------------------------------------------------------------}
  19.  
  20.  
  21. PROGRAM Vectors;
  22.  
  23. USES DOS;     { For GetIntVec and SetIntVec }
  24.  
  25. {$V-}         { Relaxes type checking on string lengths }
  26.  
  27. CONST
  28.   Up = True;
  29.  
  30. TYPE
  31.   String80    = String[80];
  32.   Block       = ARRAY[0..255] OF Byte;
  33.   PtrPieces   = ARRAY[0..3] OF Byte;
  34.  
  35. VAR
  36.   I             : Integer;
  37.   VectorNumber  : Integer;
  38.   Vector        : Pointer;
  39.   VSeg,VOfs     : Integer;
  40.   NewVector     : Integer;
  41.   MemBlock      : Block;
  42.   ErrorPosition : Integer;
  43.   Quit          : Boolean;
  44.   Command       : String80;
  45.   CommandChar   : Char;
  46.  
  47.  
  48.  
  49. PROCEDURE StripWhite(VAR Target : String);
  50.  
  51. CONST
  52.   Whitespace  : SET OF Char = [#8,#10,#12,#13,' '];
  53.  
  54. BEGIN
  55.   WHILE (Length(Target) > 0) AND (Target[1] IN Whitespace) DO
  56.     Delete(Target,1,1)
  57. END;
  58.  
  59.  
  60. PROCEDURE WriteHex(BT : Byte);
  61.  
  62. CONST
  63.   HexDigits : ARRAY[0..15] OF Char = '0123456789ABCDEF';
  64.  
  65. VAR
  66.   BZ : Byte;
  67.  
  68. BEGIN
  69.   BZ := BT AND $0F;
  70.   BT := BT SHR 4;
  71.   Write(HexDigits[BT],HexDigits[BZ])
  72. END;
  73.  
  74.  
  75. {<<<< ForceCase >>>>}
  76. { From: COMPLETE TURBO PASCAL by Jeff Duntemann  }
  77. { Scott, Foresman & Co. 1986  ISBN 0-673-18600-8 }
  78. { Described in section 15.3 -- Last mod 2/1/86   }
  79.  
  80. FUNCTION ForceCase(Up : BOOLEAN; Target : String) : String;
  81.  
  82. CONST
  83.   Uppercase : SET OF Char = ['A'..'Z'];
  84.   Lowercase : SET OF Char = ['a'..'z'];
  85.  
  86. VAR
  87.   I : INTEGER;
  88.  
  89. BEGIN
  90.   IF Up THEN FOR I := 1 TO Length(Target) DO
  91.     IF Target[I] IN Lowercase THEN
  92.       Target[I] := UpCase(Target[I])
  93.     ELSE { NULL }
  94.   ELSE FOR I := 1 TO Length(Target) DO
  95.     IF Target[I] IN Uppercase THEN
  96.       Target[I] := Chr(Ord(Target[I])+32);
  97.   ForceCase := Target
  98. END;
  99.  
  100.  
  101.  
  102. Procedure ValHex(HexString : String;
  103.                  VAR Value : LongInt;
  104.                  VAR ErrCode : Integer);
  105.  
  106. VAR
  107.   HexDigits  : String;
  108.   Position   : Integer;
  109.   PlaceValue : LongInt;
  110.   TempValue  : LongInt;
  111.   I          : Integer;
  112.  
  113. BEGIN
  114.   ErrCode := 0; TempValue := 0; PlaceValue := 1;
  115.   HexDigits := '0123456789ABCDEF';
  116.   StripWhite(HexString);   { Get rid of leading whitespace }
  117.   IF Pos('$',HexString) = 1 THEN Delete(Hexstring,1,1);
  118.   HexString := ForceCase(Up,HexString);
  119.   IF (Length(HexString) > 8) THEN ErrCode := 9
  120.     ELSE IF (Length(HexString) < 1) THEN ErrCode := 1
  121.   ELSE
  122.     BEGIN
  123.       FOR I := Length(HexString) DOWNTO 1 DO  { For each character }
  124.         BEGIN
  125.           { The position of the character in the string is its value: }
  126.           Position := Pos(Copy(HexString,I,1),HexDigits) ;
  127.           IF Position = 0 THEN   { If we find an invalid character... }
  128.             BEGIN
  129.               ErrCode := I;      { ...set the error code... }
  130.               Exit               { ...and exit the procedure }
  131.             END;
  132.           { The next line calculates the value of the given digit }
  133.           { and adds it to the cumulative value of the string: }
  134.           TempValue := TempValue + ((Position-1) * PlaceValue);
  135.           PlaceValue := PlaceValue * 16;  { Move to next place }
  136.         END;
  137.       Value := TempValue
  138.     END
  139. END;
  140.  
  141.  
  142.  
  143. PROCEDURE DumpBlock(XBlock : Block);
  144.  
  145. VAR
  146.   I,J,K : Integer;
  147.   Ch    : Char;
  148.  
  149. BEGIN
  150.   FOR I:=0 TO 15 DO        { Do a hexdump of 16 lines of 16 chars }
  151.     BEGIN
  152.       FOR J:=0 TO 15 DO    { Show hex values }
  153.         BEGIN
  154.           WriteHex(Ord(XBlock[(I*16)+J]));
  155.           Write(' ')
  156.         END;
  157.       Write('   |');           { Bar to separate hex & ASCII }
  158.       FOR J:=0 TO 15 DO        { Show printable chars or '.' }
  159.         BEGIN
  160.           Ch:=Chr(XBlock[(I*16)+J]);
  161.           IF ((Ord(Ch)<127) AND (Ord(Ch)>31))
  162.           THEN Write(Ch) ELSE Write('.')
  163.         END;
  164.       Writeln('|')
  165.     END;
  166.   FOR I:=0 TO 1 DO Writeln('')
  167. END;  { DumpBlock }
  168.  
  169.  
  170. PROCEDURE ShowHelp;
  171.  
  172. BEGIN
  173.   Writeln;
  174.   Writeln('Press RETURN to advance to the next vector.');
  175.   Writeln;
  176.   Writeln('To display a specific vector, enter the vector number (0-255)');
  177.   Writeln('in decimal or preceded by a "$" for hex, followed by RETURN.');
  178.   Writeln;
  179.   Writeln('Valid commands are:');
  180.   Writeln;
  181.   Writeln('D : Dump the first 256 bytes pointed to by the current vector');
  182.   Writeln('E : Enter a new value (decimal or hex) for the current vector');
  183.   Writeln('H : Display this help message');
  184.   Writeln('Q : Exit VECTORS ');
  185.   Writeln('X : Exit VECTORS ');
  186.   Writeln('Z : Zero segment and offset of the current vector');
  187.   Writeln('? : Display this help message');
  188.   Writeln;
  189.   Writeln
  190.   ('The indicator ">>IRET" means the vector points to an IRET instruction');
  191.   Writeln;
  192. END;
  193.  
  194.  
  195.  
  196. PROCEDURE DisplayVector(VectorNumber : Integer);
  197.  
  198. VAR
  199.   Bump : Integer;
  200.   Chunks : PtrPieces;
  201.   Vector : Pointer;
  202.   Tester : ^Byte;
  203.  
  204. BEGIN
  205.   GetIntVec(VectorNumber,Vector);{ Get the vector }
  206.   Tester := Vector;              { Can't dereference untyped pointer }
  207.   Chunks := PtrPieces(Vector);   { Cast Vector onto Chunks }
  208.   Write(VectorNumber : 3,'  $');
  209.   WriteHex(VectorNumber);
  210.   Write('  [');
  211.   WriteHex(Chunks[3]);           { Write out the chunks as hex digits }
  212.   WriteHex(Chunks[2]);
  213.   Write(':');
  214.   WriteHex(Chunks[1]);
  215.   WriteHex(Chunks[0]);
  216.   Write(']');
  217.   IF Tester^ = $CF               { If vector points to an IRET, say so }
  218.     THEN Write(' >>IRET ')
  219.     ELSE Write('        ');
  220. END;
  221.  
  222.  
  223. PROCEDURE DumpTargetData(VectorNumber : Integer);
  224.  
  225. VAR
  226.   Vector : Pointer;
  227.   Tester : ^Block;
  228.  
  229. BEGIN
  230.   GetIntVec(VectorNumber,Vector);  { Get the vector }
  231.   Tester := Vector;         { Cast the vector onto a pointer to a block }
  232.   MemBlock := Tester^;      { Copy the target block into MemBlock }
  233.   IF MemBlock[0] = $CF THEN { See if the first byte is an IRET }
  234.     Writeln('Vector points to an IRET.');
  235.   DumpBlock(MemBlock)       { and finally, hexdump the block. }
  236. END;
  237.  
  238.  
  239.  
  240. PROCEDURE ChangeVector(VectorNumber: Integer);
  241.  
  242. VAR
  243.   Vector : Pointer;
  244.   LongTemp,TempValue : LongInt;
  245.   SegPart,OfsPart : Word;
  246.  
  247. BEGIN
  248.   GetIntVec(VectorNumber,Vector);   { Get current value of vector }
  249.   LongTemp := LongInt(Vector);      { Cast Pointer onto LongInt }
  250.   SegPart := LongTemp SHR 16;       { Separate pointer segment from offset }
  251.   OfsPart := LongTemp AND $0000FFFF;  { And keep until changed }
  252.   Write('Enter segment ');
  253.   Write('(RETURN retains current value): ');
  254.   Readln(Command);
  255.   StripWhite(Command);
  256.   IF Length(Command) > 0 THEN { If something other than RETURN was entered }
  257.     BEGIN
  258.       Val(Command,TempValue,ErrorPosition);  { Evaluate as decimal }
  259.       IF ErrorPosition = 0 THEN SegPart := TempValue
  260.         ELSE       { If it's not a valid decimal value, evaluate as hex: }
  261.           BEGIN
  262.             ValHex(Command,TempValue,ErrorPosition);
  263.             IF ErrorPosition = 0 THEN SegPart := TempValue
  264.           END;
  265.       Vector := Ptr(SegPart,OfsPart);  { Reset the vector with any changes }
  266.       SetIntVec(VectorNumber,Vector);
  267.     END;
  268.   DisplayVector(VectorNumber); { Show it to reflect changes to segment part }
  269.   Writeln;
  270.   Write('Enter offset  ');     { Now get an offset }
  271.   Write('(RETURN retains current value): ');
  272.   Readln(Command);
  273.   StripWhite(Command);
  274.   IF Length(Command) > 0 THEN { If something other than RETURN was entered }
  275.     BEGIN
  276.       Val(Command,TempValue,ErrorPosition);  { Evaluate as decimal }
  277.       IF ErrorPosition = 0 THEN OfsPart := TempValue
  278.         ELSE       { If it's not a valid decimal value, evaluate as hex: }
  279.           BEGIN
  280.             ValHex(Command,TempValue,ErrorPosition);
  281.             IF ErrorPosition = 0 THEN OfsPart := TempValue
  282.           END
  283.     END;
  284.   Vector := Ptr(SegPart,OfsPart);  { Finally, reset vector with any change: }
  285.   SetIntVec(VectorNumber,Vector);
  286. END;
  287.  
  288.  
  289.  
  290.  
  291. BEGIN
  292.   Quit := False;
  293.   VectorNumber := 0;
  294.   Writeln('>>VECTORS<<   V2.00 by Jeff Duntemann');
  295.   Writeln('              From the book: COMPLETE TURBO PASCAL 5.0');
  296.   Writeln('              Scott, Foresman & Company, 1988');
  297.   Writeln('              ISBN 0-673-38355-5');
  298.   Writeln;
  299.   ShowHelp;
  300.  
  301.   REPEAT
  302.     DisplayVector(VectorNumber);   { Show the vector # & address }
  303.     Readln(Command);               { Get a command from the user }
  304.     IF Length(Command) > 0 THEN    { If something was typed:     }
  305.       BEGIN
  306.         { See if a number was typed; if one was, it becomes the current }
  307.         { vector number.  If an error in converting the string to a     }
  308.         { number occurs, Vectors then parses the string as a command.   }
  309.         Val(Command,NewVector,ErrorPosition);
  310.         IF ErrorPosition = 0 THEN VectorNumber := NewVector
  311.           ELSE
  312.             BEGIN
  313.               StripWhite(Command);        { Remove leading whitespace   }
  314.               Command := ForceCase(Up,Command); { Force to upper case   }
  315.               CommandChar := Command[1];  { Isolate first char.   }
  316.               CASE CommandChar OF
  317.                 'Q','X' : Quit := True;   { Exit VECTORS }
  318.                 'D'     : DumpTargetData(VectorNumber); { Dump data }
  319.                 'E'     : ChangeVector(VectorNumber);   { Enter new value }
  320.                 'H'     : ShowHelp;
  321.                 'Z'     : BEGIN           { Zero the vector }
  322.                             Vector := NIL;   { NIL is 32 zero bits }
  323.                             SetIntVec(VectorNumber,Vector);
  324.                             DisplayVector(VectorNumber);
  325.                             Writeln('zeroed.');
  326.                             VectorNumber := (VectorNumber + 1) MOD 256
  327.                           END;
  328.                 '?'     : ShowHelp;
  329.               END {CASE}
  330.             END
  331.       END
  332.     { The following line increments the vector number, rolling over to 0 }
  333.     { if the number would have exceeded 255: }
  334.     ELSE VectorNumber := (VectorNumber + 1) MOD 256
  335.   UNTIL Quit;
  336. END.
  337.